﻿'This Source Code Form Is subject To the terms Of the Mozilla Public
'License, v. 2.0. If a copy of the MPL was Not distributed with this
'file, You can obtain one at http: //mozilla.org/MPL/2.0/.
Imports System.IO
Imports ScroogeReports.SSRS_RS2010
Imports ScroogeReports.SSRS_Exec2005
Imports System.Net.Mail
Imports System.Web.Services.Protocols
Imports NLog.Config
Imports NLog.Targets
Imports NLog

Module ScroogeReports
    Private Structure ReportParam
        Public ParameterName As String
        Public ParameterType As String 'SSRS_Exec2005.ParameterTypeEnum
        Public ParameterHasDefaultValue As Boolean
        Public ParameterAllowsNulls As Boolean
        Public ExistsInInput As Boolean
        Public InputAllowsNulls As Boolean
        Public InputDataType As String
        Public InputOrdinal As Integer
    End Structure

    Private oLog As Logger = LogManager.GetCurrentClassLogger

    'Private Sub CreateLogFile()
    '    Dim DefaultLogPath As String = Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location) & "\Logs\ScroogeReports.log"
    '    If File.Exists(DefaultLogPath) Then
    '        If New FileInfo(DefaultLogPath).Length > 5242880 Then
    '            File.Move(DefaultLogPath, DefaultLogPath & Format(Now, "yyyy-MM-dd_HH-mm-ss"))
    '            File.Create(DefaultLogPath)
    '        End If
    '    Else
    '        File.Create(DefaultLogPath)
    '    End If
    '    If Not IsNothing(oLogWriter) Then
    '        oLogWriter.Close()
    '        oLogWriter.Dispose()
    '    End If
    '    oLogWriter = File.OpenWrite(DefaultLogPath)
    'End Sub
    'Private Sub CreateLogfile(logPath As String)
    '    If File.Exists(logPath) Then
    '        If New FileInfo(logPath).Length > 5242880 Then
    '            File.Move(logPath, logPath & Format(Now, "yyyy-MM-dd_HH-mm-ss"))
    '            File.Create(logPath)
    '        End If
    '    Else
    '        File.Create(logPath)
    '    End If
    '    If Not IsNothing(oLogWriter) Then
    '        oLogWriter.Close()
    '        oLogWriter.Dispose()
    '    End If
    '    oLogWriter = File.OpenWrite(logPath)
    'End Sub

    Private Sub createParamTemplate(ByRef REPTable As DataTable)
        Dim odr As DataRow
        odr = REPTable.NewRow
        odr.Item("ReportServerURL") = "http/s Location of reportserver, excluding final slash"
        odr.Item("ReportLocation") = "Report to be run, including leading slash, but excluding final slash or .rdl"
        odr.Item("ListDataSource") = "SQL Server address/instance where the list can be obtained"
        odr.Item("ListInitialCatalogue") = "SQL Database that the list is within"
        odr.Item("ListProcedureName") = "SQL Stored Procedure which contains the list. Must run without input parameters and meet the criteria described in the readme"
        odr.Item("OutputFormat") = "One of the SSRS Output format names; MHTML, EXCEL, EXCELOPENXML, CSV etc"
        odr.Item("OutputExtension") = "File extension to add onto the exported files. Should be the right one for the format that you have selected above"
        odr.Item("DeliveryEmailHost") = "[optional] Hostname or IP address of SMTP server. Must be able to authenticate anonymously. Port Number below is also optional."
        odr.Item("DeliveryEmailPort") = 0
        odr.Item("DeliveryEmailFrom") = "[optional] Address to send the report as."
        odr.Item("LogPath") = "[optional] Write log to this address. Otherwise writes to working directory"
        REPTable.Rows.Add(odr)
    End Sub

    Sub Main()
        Dim args As String() = Environment.GetCommandLineArgs()
        Dim oDS As DataSet
        Dim oFS As System.IO.FileStream
        Dim odr As DataRow


        checkForLogConfiguration()

        oLog.Info("ScroogeReports Startup")


        If args.Length = 3 Then
            oLog.Info("Found arguments {1},{2}", args(1).ToString, args(2).ToString)
            If ((UCase(args(1)) = "/I" And File.Exists(args(2))) Or (UCase(args(1)) = "/O" And Not File.Exists(args(2)))) Then
                oLog.Debug("Creating dataset template, pre-loading.")
                oDS = dataSetTemplate()
                oLog.Debug("Dataset template created, pre-loading")
                If UCase(args(1)) = "/I" Then
                    oLog.Info("Running in Input mode. Filepath will be checked for a workable input file.")
                    Try
                        oDS.ReadXml(args(2))
                        Dim oDT As DataTable
                        Try
                            oDT = oDS.Tables("ReportExecutionParameters")
                            oLog.Info("Working through {1} report sets", oDT.Rows.Count)

                            For Each odr In oDT.Rows

                                With odr
                                    Try
                                        runReportSet(.Item("ReportServerURL"),
                                             .Item("ReportLocation"),
                                             .Item("ListDataSource"),
                                             .Item("ListInitialCatalogue"),
                                             .Item("ListProcedureName"),
                                             .Item("OutputFormat"),
                                             .Item("OutputExtension"),
                                             DBNullToNothing(.Item("LogPath")),
                                             DBNullToNothing(.Item("DeliveryEmailHost")),
                                             DBNullToNothing(.Item("DeliveryEmailPort")),
                                             DBNullToNothing(.Item("DeliveryEmailFrom"))
                                             )
                                    Catch ex As Exception

                                    End Try
                                End With
                            Next

                        Catch ex As Exception

                        End Try

                    Catch ex1 As Exception
                        oLog.Error(ex1, "Unable to read file {1} as input", args(2))
                    End Try

                Else
                    oLog.Info("Running in Output mode. Template input file will be created at Filepath.")
                    'odr = oDS.Tables("ReportExecutionParameters").NewRow()
                    oLog.Debug("Populating dataset template with field descriptions")
                    createParamTemplate(oDS.Tables("ReportExecutionParameters"))

                    'oDS.Tables("ReportExecutionParameters").Rows.Add(odr)

                    oLog.Info("Attempting to create new file at {1}", args(2))
                    Try
                        oFS = New System.IO.FileStream(args(2), FileMode.CreateNew)
                        oLog.Debug("File Created")
                        oDS.WriteXml(oFS)
                        oLog.Info("Output file written")
                    Catch ex As Exception
                        oLog.Error(ex, "Failed to create file at {1}", args(2))
                    End Try


                End If
            Else
                If UCase(args(1)) = "/I" Then
                    oLog.Error("Input file {1} does not exist.", args(2))
                ElseIf UCase(args(1)) = "/O" Then
                    oLog.Error("File {1} exists. Filepath cannot point to an extant file when running in output mode.", args(2))
                Else
                    oLog.Error("Only valid switches are /i and /o")
                End If
                Console.WriteLine("Input parameters should be /i [filepath] or /o [filepath]. Please see readme for details.")
            End If
        Else
            oLog.Error("Wrong number of parameters")
            oLog.Error("Input parameters should be /i [filepath] or /o [filepath]. Please see readme for details.")
            Console.WriteLine("Input parameters should be /i [filepath] or /o [filepath]. Please see readme for details.")
        End If



    End Sub

    Private Function DBNullToNothing(field As Object) As Object
        If IsDBNull(field) Then
            Return Nothing
        Else
            Return field
        End If
    End Function

    Private Sub addColumn(ByRef ReceivingTable As System.Data.DataTable, ByVal ColumnName As String, ByVal TypeName As String, ByVal AllowNull As Boolean)
        Dim oDC As New System.Data.DataColumn
        oDC.ColumnName = ColumnName
        oDC.DataType = System.Type.GetType("System." & TypeName)
        oDC.AllowDBNull = AllowNull
        ReceivingTable.Columns.Add(oDC)
    End Sub

    Private Function dataSetTemplate() As DataSet
        Dim oDS As New DataSet
        oDS.DataSetName = "ReportExecution"

        Dim oDT As New DataTable
        oDT.TableName = "ReportExecutionParameters"
        addColumn(oDT, "ReportServerURL", "String", False)
        addColumn(oDT, "ReportLocation", "String", False)
        addColumn(oDT, "ListDataSource", "String", False)
        addColumn(oDT, "ListInitialCatalogue", "String", False)
        addColumn(oDT, "ListProcedureName", "String", False)
        addColumn(oDT, "OutputFormat", "String", False)
        addColumn(oDT, "OutputExtension", "String", False)
        addColumn(oDT, "DeliveryEmailHost", "String", True)
        addColumn(oDT, "DeliveryEmailPort", "UInt16", True)
        addColumn(oDT, "DeliveryEmailFrom", "String", True)
        addColumn(oDT, "LogPath", "String", True)
        oDS.Tables.Add(oDT)

        Return oDS
    End Function

    Private Function GetProcMetadata(DataSource As String, InitialCatalog As String, ProcName As String) As System.Data.DataTable
        'Create a connection to the SQL Server
        Dim oCon As New SqlClient.SqlConnection
        Dim cstb As New SqlClient.SqlConnectionStringBuilder

        cstb.DataSource = DataSource
        cstb.IntegratedSecurity = True
        cstb.InitialCatalog = InitialCatalog
        cstb.ConnectTimeout = 120
        oCon.ConnectionString = cstb.ConnectionString
        oCon.Open()

        'Create a command object. This gets used more than once.
        Dim oCmd As New SqlClient.SqlCommand
        oCmd.Connection = oCon

        'Run a query to find out whjat version of SQL Server we're using - then we can choose method to get output columns appropriately
        oCmd.CommandText = "SELECT cast(left(cast(SERVERPROPERTY('productversion') as varchar(50)), charindex('.',cast(SERVERPROPERTY('productversion') as varchar(50)),1)-1) as int) AS SQLVersion"
        oCmd.CommandType = CommandType.Text

        Dim SQLVersion As Integer

        Try
            SQLVersion = oCmd.ExecuteScalar
        Catch ex As Exception
            SQLVersion = 10
        End Try
        Dim oDR As SqlClient.SqlDataReader
        Dim dt As DataTable

        Dim dr As DataRow
        If SQLVersion > 10 Then 'SQL Server 2012 or above
            'Set the command text to run a query which gets the output columns of the specified procedure.
            oCmd.CommandText = "select column_ordinal, name, is_nullable, system_type_name From sys.dm_exec_describe_first_result_set_for_object(object_id(@ProcName),0)"
            oCmd.CommandType = CommandType.Text
            oCmd.Parameters.Add(New SqlClient.SqlParameter("@ProcName", ProcName))
            'Run the query to get output column defintions. Dump the result into a datatable and close the datareader to free up SQL Server resources.
            oDR = oCmd.ExecuteReader()
            dt = New DataTable()
            dt.Load(oDR)
            oDR.Close()
            oDR = Nothing
        Else 'SQL Server 2008R2 or below.
            'Run the query with set FMTONLY on
            oCmd.CommandText = "set fmtonly on; begin try exec @procname; end try begin catch end catch set fmtonly off;"
            oCmd.CommandType = CommandType.Text
            oCmd.Parameters.Add(New SqlClient.SqlParameter("@ProcName", ProcName))
            oDR = oCmd.ExecuteReader()
            oDR.Read()
            Dim oDT As DataTable
            oDT = New DataTable
            oDT.Load(oDR)
            oDR.Close()
            oDR = Nothing
            dt = makeColumnResultTable()
            'Scroll all the columns in the (actually empty) datatable, and populate the important ones ready for the next step
            Dim i As Integer
            For i = 1 To dt.Columns.Count
                dr = dt.NewRow
                dr.Item("name") = oDT.Columns(i - 1).ColumnName
                dr.Item("column_ordinal") = i
                dr.Item("is_nullable") = oDT.Columns(i - 1).AllowDBNull
                dr.Item("system_type_name") = oDT.Columns(i - 1).DataType.Name
                dt.Rows.Add(dr)
            Next
        End If
        Return dt
    End Function


    Private Sub runReportSet(ByVal ReportServerURL As String,
                            ByVal ReportLocation As String,
                            ByVal ListDataSource As String,
                            ByVal ListInitialCatalogue As String,
                            ByVal ListProcedureName As String,
                            ByVal OutputFormat As String,
                            ByVal OutputExtension As String,
                            ByVal LogPath As String, 'Not actually used - no logging done at the moment.
                            ByVal DeliveryEmailHost As String,
                            ByVal DeliveryEmailPort As Integer,
                            ByVal DeliveryEmailFrom As String)

        Dim rsi As New ReportingService2010()
        rsi.Credentials = System.Net.CredentialCache.DefaultCredentials
        rsi.Url = ReportServerURL & "/ReportService2010.asmx"

        Dim params As SSRS_RS2010.ItemParameter()

        params = rsi.GetItemParameters(ReportLocation, Nothing, True, Nothing, Nothing)
        Dim copyParams(params.Length - 1) As ReportParam

        Dim i As Integer

        'Take a copy of all the parameters of the report into a local data structure, so we can see which ones we have values for.
        For i = 0 To params.Length - 1
            copyParams(i).ParameterName = params(i).Name
            copyParams(i).ParameterType = params(i).ParameterTypeName
            copyParams(i).ParameterHasDefaultValue = IIf(IsNothing(params(i).DefaultValues()), False, True)
            copyParams(i).ParameterAllowsNulls = params(i).Nullable
            copyParams(i).ExistsInInput = False 'Set them all false here, and then flip the others back to true later
        Next i

        'Check the metadata of the distribution list stored proc
        Dim dt As DataTable
        dt = GetProcMetadata(ListDataSource, ListInitialCatalogue, ListProcedureName)

        'This section interrogates the output columns to see if there are any with special names, or if they match the names of any report parameters.
        Dim EmailDelivery As Boolean = False
        Dim EmailOrdinal As Integer
        Dim FileshareDelivery As Boolean = False
        Dim FileshareOrdinal As Integer
        Dim OverrideFilename As Boolean = False
        Dim FilenameOrdinal As Integer

        'Dim dr As DataRow
        For Each dr In dt.Rows
            If UCase(CStr(dr.Item("name"))) = "EMAIL" Then
                EmailDelivery = True
                EmailOrdinal = CInt(dr.Item("column_ordinal")) - 1
            ElseIf UCase(CStr(dr.Item("name"))) = "FILEPATH" Then
                FileshareDelivery = True
                FileshareOrdinal = CInt(dr.Item("column_ordinal")) - 1
            ElseIf UCase(CStr(dr.Item("name"))) = "FILENAME" Then
                OverrideFilename = True
                FilenameOrdinal = CInt(dr.Item("column_ordinal")) - 1
            End If

            For i = 0 To copyParams.Length - 1
                If UCase(copyParams(i).ParameterName) = UCase(CStr(dr.Item("name"))) Then
                    copyParams(i).ExistsInInput = True
                    copyParams(i).InputAllowsNulls = CBool(dr.Item("is_nullable"))
                    copyParams(i).InputDataType = CStr(dr.Item("system_type_name"))
                    copyParams(i).InputOrdinal = CInt(dr.Item("column_ordinal")) - 1
                End If
            Next i
        Next dr
        'Switch email delivery off if we weren't given details of an smtp server to use
        If IsNothing(DeliveryEmailHost) Then
            EmailDelivery = False
        End If


        Dim oCon As New SqlClient.SqlConnection
        Dim cstb As New SqlClient.SqlConnectionStringBuilder
        Dim oCmd As SqlClient.SqlCommand
        Dim oDR As SqlClient.SqlDataReader
        Dim oDT As DataTable

        cstb.DataSource = ListDataSource
        cstb.IntegratedSecurity = True
        cstb.InitialCatalog = ListInitialCatalogue
        cstb.ConnectTimeout = 120
        oCon.ConnectionString = cstb.ConnectionString
        oCon.Open()

        oCmd = New SqlClient.SqlCommand
        oCmd.Parameters.Clear()
        oCmd.CommandText = ListProcedureName
        oCmd.CommandType = CommandType.StoredProcedure
        oDR = oCmd.ExecuteReader

        Dim validDeliveryDetails As Boolean
        Dim DeliverByEmail As Boolean
        Dim DeliverByFileshare As Boolean
        Dim parameters As SSRS_Exec2005.ParameterValue()

        'Copy the subscription list into a datatable to work through
        'Dim oDT As New DataTable
        oDT = New DataTable
        oDT.Load(oDR)
        'And then get rid of all the SQL objects
        oDR.Close()
        oDR = Nothing
        oCmd.Dispose()
        oCon.Close()
        oCon.Dispose()

        Dim AllParamsCanBeSatisfied As Boolean
        Dim pal As New List(Of SSRS_Exec2005.ParameterValue)
        Dim pv As SSRS_Exec2005.ParameterValue

        Dim rs As New ReportExecutionService()
        rs.Credentials = System.Net.CredentialCache.DefaultCredentials
        rs.Url = ReportServerURL & "/ReportExecution2005.asmx"


        Dim historyID As String = Nothing
        Dim execHeader As New ExecutionHeader()
        rs.ExecutionHeaderValue = execHeader
        rs.Timeout = 3600000
        Dim execInfo As New ExecutionInfo
        execInfo = rs.LoadReport(ReportLocation, historyID)

        'Dim credentials As SSRS_Exec2005.DataSourceCredentials() = Nothing
        'Dim showHideToggle As String = Nothing
        'Dim reportHistoryParameters As SSRS_Exec2005.ParameterValue() = Nothing

        ' Render arguments
        Dim format As String = OutputFormat
        Dim devInfo As String = "<DeviceInfo><Toolbar>False</Toolbar></DeviceInfo>"
        Dim extension As String = ""
        Dim encoding As String = ""
        Dim mimeType As String = ""
        Dim warnings As SSRS_Exec2005.Warning() = Nothing
        Dim streamIDs As String() = Nothing
        Dim result As Byte() = Nothing
        Dim SessionId As String

        Dim Filename As String
        Dim FilenameWithExtension As String
        Dim ShareFolderPath As String
        Dim shareCompletePath
        Dim stream As FileStream

        Dim EmailAddress
        Dim Smtp_Server As SmtpClient
        Dim e_mail As MailMessage
        If EmailDelivery Then
            Smtp_Server = New SmtpClient
            Smtp_Server.UseDefaultCredentials = False
            Smtp_Server.Host = DeliveryEmailHost
            Smtp_Server.Port = DeliveryEmailPort
        End If


        For Each dr In oDT.Rows
            'Check that we've got at least one place to deliver the report to, otherwise it's not worth running it.
            validDeliveryDetails = False
            DeliverByEmail = False
            DeliverByFileshare = False
            AllParamsCanBeSatisfied = True
            parameters = Nothing
            result = Nothing
            Filename = ""
            shareCompletePath = ""
            If OverrideFilename And Not IsDBNull(dr.Item(FilenameOrdinal)) Then
                Filename = CStr(dr.Item(FilenameOrdinal))
            Else
                Filename = Microsoft.VisualBasic.Right(ReportLocation, Len(ReportLocation) - InStrRev(ReportLocation, "/"))
            End If
            FilenameWithExtension = Filename & "." & OutputExtension
            If EmailDelivery And Len(CStr(IIf(IsDBNull(dr.Item(EmailOrdinal)), "", dr.Item(EmailOrdinal)))) > 2 Then
                validDeliveryDetails = True
                DeliverByEmail = True
                EmailAddress = CStr(dr.Item(EmailOrdinal))
            End If
            If FileshareDelivery And Len(CStr(IIf(IsDBNull(dr.Item(FileshareOrdinal)), "", dr.Item(FileshareOrdinal)))) > 2 Then
                validDeliveryDetails = True
                DeliverByFileshare = True
                ShareFolderPath = CStr(dr.Item(FileshareOrdinal))
                shareCompletePath = Path.GetDirectoryName(ShareFolderPath) & "\" & FilenameWithExtension
            End If
            If validDeliveryDetails Then
                pal.Clear()
                For i = 0 To copyParams.Length - 1
                    If (Not IsDBNull(dr.Item(copyParams(i).InputOrdinal))) Or copyParams(i).ParameterHasDefaultValue Then
                        If Not IsDBNull(dr.Item(copyParams(i).InputOrdinal)) Then
                            pv = New SSRS_Exec2005.ParameterValue
                            pv.Name = copyParams(i).ParameterName
                            pv.Value = CStr(dr.Item(copyParams(i).InputOrdinal))
                            pal.Add(pv)
                        End If
                    Else
                        AllParamsCanBeSatisfied = False
                    End If
                Next

                If AllParamsCanBeSatisfied Then
                    parameters = pal.ToArray()
                End If

                'Run the report...
                rs.SetExecutionParameters(parameters, "en-us")
                SessionId = rs.ExecutionHeaderValue.ExecutionID
                Console.WriteLine("SessionID: {0}", rs.ExecutionHeaderValue.ExecutionID)
                Try
                    result = rs.Render(format, devInfo, extension, encoding, mimeType, warnings, streamIDs)
                    execInfo = rs.GetExecutionInfo()
                    Console.WriteLine("Execution date and time: {0}", execInfo.ExecutionDateTime)

                Catch e1 As SoapException
                    Console.WriteLine(e1.Detail.OuterXml)
                End Try

                If result IsNot Nothing Then 'So long as we ended up with a file to send...
                    If DeliverByFileshare Then
                        Try
                            System.IO.Directory.CreateDirectory(Path.GetDirectoryName(shareCompletePath))
                            stream = File.Create(shareCompletePath, result.Length)
                            stream.Write(result, 0, result.Length)
                            stream.Close()
                        Catch e1 As Exception
                            Console.WriteLine(e1.Message)
                        End Try
                    End If
                    If DeliverByEmail Then
                        Try
                            e_mail = New MailMessage()
                            e_mail.From = New MailAddress(DeliveryEmailFrom)
                            e_mail.To.Add(EmailAddress)
                            e_mail.Subject = "Report " & Filename & " attached"
                            e_mail.IsBodyHtml = False
                            e_mail.Body = "Please find your copy of report " & Filename & " attached"
                            e_mail.Attachments.Add(New Attachment(New MemoryStream(result), FilenameWithExtension))
                            Smtp_Server.Send(e_mail)
                        Catch e2 As Exception
                            Console.WriteLine(e2.Message)
                        End Try
                    End If

                Else
                    'We should have some error-handling in here, really.
                End If

            End If

        Next dr

    End Sub
    Function makeColumnResultTable() As DataTable
        Dim oDT As New DataTable
        oDT.Columns.Add("name", System.Type.GetType("System.String"))
        oDT.Columns.Add("column_ordinal", System.Type.GetType("System.Int32"))
        oDT.Columns.Add("is_nullable", System.Type.GetType("System.Boolean"))
        oDT.Columns.Add("system_type_name", System.Type.GetType("System.String"))
        Return oDT
    End Function

    Private Sub checkForLogConfiguration()
        Dim oLC As LoggingConfiguration


        If NLog.LogManager.Configuration Is Nothing Then 'If we don't have any pre-defined log configuration
            oLC = New LoggingConfiguration
            Dim oFT As New FileTarget()
            oFT.Name = "logFile"
            oFT.FileName = "${basedir}\ScroogeReportsLog.txt"
            oFT.ArchiveFileName = "${basedir}\ScroogeReportsLog - Archive - {#####}.txt"
            oFT.ArchiveNumbering = ArchiveNumberingMode.Date
            oFT.ArchiveEvery = FileArchivePeriod.Month
            oFT.KeepFileOpen = True
            oFT.OpenFileCacheTimeout = 30
            oLC.AddTarget(oFT)

            oLC.AddRule(LogLevel.Info, LogLevel.Fatal, "logFile", "*")

            oLog.Warn("No NLog configuration found, using default configuration")
        End If
    End Sub


End Module
